home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0062_Drive Info.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  9KB  |  253 lines
  1. {
  2.  A few days ago, Bryan Ellis (gt6918b@prism.gatech.edu) mentioned
  3.  that he had trouble with the DiskFree function of TP.
  4.  I did'nt see any answer on this subject posted to the list.
  5.  Since I also feel that this function yields misleading
  6.  results to the unaware, and available clusters on the disk
  7.  are also a requisite for full information, I post below a
  8.  small program to document another way to implement the
  9.  Diskfree function.
  10.  
  11. That part of the following code referring to the identification
  12. of ramdisks has already been posted on info-pascal@brl.mil; I have
  13. added the procedure DiskEval to display info about the drive, because
  14. I have found that many users are not aware of the notion of 'slack'
  15. which is the consequence of the use of clusters.
  16. }
  17.  
  18. {$N+,E+}
  19.  
  20. program diskall;
  21.  
  22. {
  23. displays all drives (except network drives :-() actually in use by
  24. the system, mentions when one is mapped to another one (such as B: to
  25. A: in systems with only one floppy drive), tries to identify RAM
  26. disks but fails to do so with 'Stacked' disks and possibly also with
  27. 'Doublespaced' drives: I refrained from trying the latter on _MY_
  28. stacked HD! The program further shows the available space on the disk
  29. chosen by the user among available drives.
  30. From what I have gathered in books and on the net, there is no fail-
  31. safe way of identifying RAM disks. If somebody among the readers of
  32. this should know otherwise, I would be grateful if he could email me
  33. the solution at:
  34.  desclinj@ulb.ac.be  (internet; Dr Jean Desclin)
  35.                      (Lab. of Histology, Fac. of Medicine)
  36.                      (Brussels Free University (U.L.B.) Belgium)
  37. }
  38. uses Dos,CRT;
  39.  
  40. Type String25 = String[25];
  41.  
  42. var
  43.     ver               : byte;
  44.     DrvStr            : String;
  45.     DrvLet            : char;
  46.     Count             : shortint;
  47.     car               : char;
  48.  
  49. Procedure Pinsert(var chain: string25);
  50. {Eases reading long numbers by inserting decimal points(commas)}
  51. Const pdec : string[1] = ',';
  52. var nv     :    string25;
  53.     loc    :    integer;
  54. begin
  55.   nv := chain;
  56.   if length(chain) > 3 then
  57.     begin
  58.        loc := length(chain) - 2;
  59.        Move(Nv[loc],Nv[succ(loc)],succ(Length(Nv))-loc);
  60.        Move(Pdec[1],Nv[loc],1);
  61.        inc(Nv[0]);
  62.        while (pos(pdec[1],Nv) > 4) do
  63.            begin
  64.               chain := Nv;
  65.               loc := pos(pdec[1],Nv) - 3;
  66.               Move(Nv[loc],Nv[succ(loc)],succ(length(Nv)) - loc);
  67.               Move(pdec[1],Nv[loc],1);
  68.               inc(Nv[0])
  69.            end;
  70.     end;
  71.   chain := nv
  72. end;
  73.  
  74. procedure GetDrives1(var DS: string);{for DOS >= 3.x but <4.0       }
  75. {Adapted from Michael Tischer's Turbo Pascal 6 System Programming,  }
  76. {Abacus 1991, ISBN 1-55755-124-3                                    }
  77. type DPBPTR    = ^DPB;           { pointer to a DOS Parameter Block }
  78.      DPBPTRPTR = ^DPBPTR;           { pointer to a pointer to a DPB }
  79.      DPB       = record       { recreation of a DOS Parameter Block }
  80.                     Code  : byte;       { drive code (0=A, 1=B etc. }
  81.                     dummy1: array [1..$07] of byte;{irrelevant bytes}
  82.                     FatNb : byte; {Number of File Allocation Tables }
  83.                     dummy2: array [9..$17] of byte;{irrelevant bytes}
  84.                     Next  : DPBPTR;           { pointer to next DPB }
  85.                  end;                    { xxxx:FFFF marks last DPB }
  86.  
  87. var Regs    : Registers;              { register for interrupt call }
  88.     CurrDpbP : DPBPTR;                  { pointer to DPBs in memory }
  89.  
  90. begin
  91.    {-- get pointer to first DPB ------------------------------------}
  92.  
  93.   Regs.AH := $52;{ function $52 returns ptr to 'List of Lists'      }
  94.   MsDos( Regs );{ that's an UNDOCUMENTED DOS function !             }
  95.   CurrDpbP := DPBPTRPTR( ptr( Regs.ES, Regs.BX ) )^;
  96.   {-- follow the chain of DPBs--------------------------------------}
  97.   repeat
  98.     begin
  99.      write(chr(ord('A')+CurrDpbP^.Code ),{ display device code  }
  100.               ': ' );
  101.      DS := DS + chr(ord('A')+CurrDpbP^.Code);
  102.      if CurrDpbP^.Code > 0 then
  103.        begin
  104.          Regs.AX := $440E;
  105.          Regs.BL := CurrDpbP^.Code;
  106.          MsDos(Regs);
  107.          if Regs.AL <> 0 then
  108.            writeln(' is actually mapped to ',
  109.                     chr(ord('A')+pred(CurrDpbP^.Code)))
  110.        end;
  111.  
  112.      if ((CurrDpbP^.FatNb > 0) AND (CurrDpbP^.FatNb < 2)) then
  113.         writeln(' (RAMDISK)');
  114.     end;
  115.      CurrDpbP := CurrDpbP^.Next;   { set pointer to next DPB        }
  116.   until ( Ofs( CurrDpbP^ ) = $FFFF );  { until last DPB is reached }
  117.  writeln
  118.  end;
  119.  
  120. procedure GetDrives2(var DS: string);{for DOS versions>=4.0         }
  121. {almost the same as GetDrives1, but for dummy2 which is one byte    }
  122. {longer in DOS 4+                                                   }
  123. type DPBPTR    = ^DPB;           { pointer to a DOS Parameter Block }
  124.      DPBPTRPTR = ^DPBPTR;           { pointer to a pointer to a DPB }
  125.      DPB       = record       { recreation of a DOS Parameter Block }
  126.                   Code   : byte;      { drive code ( 0=A, 1=B etc.  }
  127.                   dummy1 : array [1..$07] of byte;{ irrelevant bytes}
  128.                   FatNb  : byte;{ Number of File Allocation Tables  }
  129.                   dummy2 : array [9..$18] of byte;{ irrelevant bytes}
  130.                   Next   : DPBPTR;          { pointer to next DPB   }
  131.                  end;                    { xxxx:FFFF marks last DPB }
  132.  
  133. var Regs    : Registers;              { register for interrupt call }
  134.     CurrDpbP : DPBPTR;                  { pointer to DPBs in memory }
  135.  
  136. begin
  137.    {-- get pointer to first DPB-------------------------------------}
  138.  
  139.   Regs.AH := $52;{ function $52 returns ptr to Dos 'List of lists'  }
  140.    MsDos( Regs );{ that's an UNDOCUMENTED DOS function !            }
  141.  CurrDpbP := DPBPTRPTR( ptr( Regs.ES, Regs.BX ) )^;
  142.  
  143.   {-- follow the chain of DPBs -------------------------------------}
  144.  
  145.   repeat
  146.     begin
  147.      write( chr( ord('A') + CurrDpbP^.Code ),{ display device code  }
  148.               ': ');
  149.      DS := DS + chr(ord('A')+CurrDpbP^.Code);
  150.      if CurrDpbP^.Code > 0 then
  151.        begin
  152.          Regs.AX := $440E;
  153.          Regs.BL := CurrDpbP^.Code;
  154.          MsDos(Regs);
  155.          if Regs.AL <> 0 then
  156.            writeln(' is actually mapped to ',
  157.                     chr(ord('A')+pred(CurrDpbP^.Code)))
  158.        end;
  159.      if ((CurrDpbP^.FatNb > 0) AND (CurrDpbP^.FatNb < 2)) then
  160.         writeln(' (RAMDISK)');
  161.     end;
  162.      CurrDpbP := CurrDpbP^.Next;   { set pointer to next DPB        }
  163.    until ( Ofs( CurrDpbP^ ) = $FFFF );  { until last DPB is reached }
  164.    writeln
  165.  end;
  166.  
  167. Procedure DiskEval;
  168. {computes statistics of disk chosen by user}
  169.  
  170. var Reg : registers;
  171.     Drive             : char;
  172.     column,row        : shortint;
  173.     SectorsPerCluster : Word;
  174.     AvailClusters     : Word;
  175.     BytesPerSector    : Word;
  176.     TotalClusters     : Word;
  177.     BytesAvail,Clut   : longint;
  178.     Kilos             : extended;
  179.     ByAl              : string25;
  180.     TotClut           : string25;
  181.     OneClut           : string25;
  182.     AvailClut         : string25;
  183. begin
  184.     write('');
  185.     column  := whereX;
  186.     row     := whereY;
  187.     repeat
  188.        gotoXY(column,row);
  189.        write('Which drive to read from? ',' ',chr(8));
  190.        read(Drive);
  191.        Drive := UpCase(Drive);
  192.     until (pos(Drive,DrvStr) <> 0);
  193.     writeln;
  194.     with Reg do begin
  195.          DL := ord(Drive) - 64;
  196.          AH := $36;
  197.          Intr($21,Reg);
  198.          SectorsPerCluster  := AX;
  199.          AvailClusters      := BX;
  200.          BytesPerSector     := CX;
  201.          TotalClusters      := DX
  202.     end;
  203.     BytesAvail := longint(BytesPerSector) * longint(SectorsPerCluster)
  204.                   * longint(AvailClusters);
  205.     Kilos := BytesAvail/1024;
  206.     clut := longint(SectorsPerCluster)*longint(BytesPerSector);
  207.     Str(BytesAvail,Byal);
  208.     Pinsert(Byal);
  209.     Str(AvailClusters,AvailClut);
  210.     Pinsert(AvailClut);
  211.     Str(Clut,OneClut);
  212.     Pinsert(OneClut);
  213.     Str(TotalClusters,TotClut);
  214.     Pinsert(Totclut);
  215.     clrscr;
  216.     if SectorsPerCluster <> 65535 then
  217.       begin
  218.         write('For drive ');
  219.         HighVideo;
  220.         write(Drive);
  221.         LowVideo;
  222.         writeln(':');
  223.         writeln('Sectors per cluster: ',SectorsPerCluster);
  224.         writeln('Bytes per sector: ',BytesPerSector);
  225.         writeln('Total clusters: ',TotClut);
  226.         writeln('Available clusters: ',AvailClut);
  227.         write('(One cluster = ',oneclut,' bytes: the smallest');
  228.         writeln(' allocatable space!)');
  229.         write('A TOTAL of ',ByAl,' BYTES are AVAILABLE (',Kilos:6:3);
  230.         writeln(' K)') {previous line split for display: length <73 }
  231.       end
  232.     else writeln('There is no diskette in drive ',Drive,': !')
  233. end;
  234.  
  235. begin
  236.    car := #0;
  237.    repeat
  238.       DrvStr := '';
  239.       DrvLet := #0;
  240.       clrscr;
  241.       ver := Lo(DosVersion);
  242.       writeln('Installed logical drives are : '#13#10);
  243.       if ver < 4 then
  244.         GetDrives1(DrvStr)
  245.       else
  246.         GetDrives2(DrvStr);
  247.       DiskEval;
  248.       writeln;
  249.       write('type ''Y'' to continue, any other key to exit.');
  250.       car := upcase(readkey);
  251.    until (car <> 'Y')
  252. end.
  253.